The CDPD Public Domain Collection for CDTV 4/CDPD_IV.bin/e/mailinglists/amigae.0993sept.archive/000028_crash!kirk.safb.af.mil!BWILLS_Sun, 12 Sep 93 02:22:44 PST.msg

Internet Message Format | 1994-05-26 | 5KB

Received: by bkhouse.cts.com (V1.16/Amiga)
    id AA00000; Sun, 12 Sep 93 02:22:44 PST
Received: from kirk.safb.af.mil by crash.cts.com with smtp
    (Smail3.1.28.1 #18) id m0obbi8-0000YPC; Sat, 11 Sep 93 13:38 PDT
Message-Id: <[e-mail]>
Date: 11 Sep 93 15:36:00 CST
From: "Barry D. Wills" <[e-mail]>
To: "amigae" <[e-mail]>
Subject: Non-stdin (string input via IDCMP)

/*
   This example is in reply to a request from Vinny Elschot.  Sorry is took so
   long, Vinny!

   Here's a set of routines that can be used to get a string via IDCMP messages.
   The same concept can be used to get a single character from the keyboard
   without requiring a return to signal end of input as required by Inp() and
   other functions that get charactes from stdin.

   The trick here is to get a pointer to an open window so we can change it's
   IDCMP flags to get VANILLAKEY messages from intuition.  Then we just do what
   we will with the VANILLAKEYs, change the windows IDCMP flags back to the way
   they were and return whatever info we've accumulated (in this case a string.)

   To extract the scan routine and use it in your progs without modification you
   will need cursorOn(), cursorOff(), and scan(), and all the modules in the
   MODULE directive as a minimum.
*/

MODULE 'exec/strings',
       'graphics/rastport',
       'intuition/intuition',
       'intuition/screens'

RAISE "MEM" IF String()=NIL

PROC cursorOn(rp:PTR TO rastport,char)
  DEF x
  SetDrMd(rp,(RP_INVERSVID+RP_JAM2))
  x:=rp.cp_x
  Text(rp,({char}+3),1)
  rp.cp_x:=x
ENDPROC

PROC cursorOff(rp:PTR TO rastport,char)
  DEF x
  SetDrMd(rp,RP_JAM2)
  x:=rp.cp_x
  Text(rp,({char}+3),1)
  rp.cp_x:=x
ENDPROC

PROC scan(win:PTR TO window,   /* Pointer to window.                   */
          x,y,                 /* Prompt at: (-1,-1=current location.) */
          prompt:PTR TO CHAR,  /* EString, contents=what to display.   */
          answer:PTR TO CHAR)  /* EString, contents=<discarded>.       */
/* EString parameter answer will contain the input string */
/* value, and will be set to the appropriate EString      */
/* length.  The remaining paramters are unchanged.        */
  DEF rp:PTR TO rastport,oldIdcmpFlags,idcmpMessage,idcmpClass,idcmpCode,
      last,i,done=FALSE
  last:=StrMax(answer)-1
  FOR i:=0 TO last DO answer[i]:=0
  i:=0
  rp:=win.rport
  IF x=-1 THEN x:=rp.cp_x ELSE rp.cp_x:=x
  IF y<>-1 THEN rp.cp_y:=y
  Text(rp,prompt,StrLen(prompt))
  x:=rp.cp_x
  cursorOn(rp,32)
  oldIdcmpFlags:=win.flags
  ModifyIDCMP(win,IDCMP_VANILLAKEY)
  REPEAT
    idcmpClass:=WaitIMessage(win)
    SELECT idcmpClass
      CASE IDCMP_VANILLAKEY
        idcmpCode:=MsgCode()
        SELECT idcmpCode
          CASE CR
            done:=TRUE
            SetStr(answer,i)
            WHILE (idcmpMessage:=GetMsg(win.userport)) DO ReplyMsg(idcmpMessage)
            ModifyIDCMP (win,oldIdcmpFlags)
            cursorOff(rp,32)
          CASE BS
            IF i>0
              cursorOff(rp,32)
              answer[i]:=0
              rp.cp_x:=rp.cp_x-rp.txwidth
              DEC i
              cursorOn(rp,32)
            ENDIF
          DEFAULT
            IF (i <= last) AND (idcmpCode>=32) AND (idcmpCode<=126)
              answer[i]:=idcmpCode
              cursorOff(rp,answer[i])
              rp.cp_x:=rp.cp_x+rp.txwidth
              INC i
              cursorOn(rp,32)
            ENDIF
        ENDSELECT
      DEFAULT;
        WriteF('scan():  Unknown IDCMP class=\d\n',idcmpClass)
    ENDSELECT
  UNTIL done
ENDPROC
  /* scan */

PROC clearLine(rp:PTR TO rastport,x,y,length)
  DEF i
  rp.cp_x:=x;rp.cp_y:=y
  FOR i := 1 TO length DO Text(rp,' ',1)
ENDPROC
  /* clearLine */

PROC display(rp:PTR TO rastport,x,y,s)
  IF StrLen(s)
    IF x>-1 THEN rp.cp_x:=x
    IF y>-1 THEN rp.cp_y:=y
    Text(rp,s,StrLen(s))
  ENDIF
ENDPROC
  /* display */

PROC main() HANDLE
  DEF msgWin=NIL:PTR TO window,
      prompt=NIL:PTR TO CHAR,
      answer=NIL:PTR TO CHAR,
      rp=NIL:PTR TO rastport,
      x,y,done=FALSE
  IF (msgWin:=OpenW(10,20,200,21,NIL,WFLG_WINDOWACTIVE+WFLG_DRAGBAR,
                    'Scan A String',NIL,WBENCHSCREEN,NIL))<>NIL
    prompt:=String(8)
    answer:=String(11)
    StrCopy(prompt,'Q=quit: ',ALL)
    rp:=msgWin.rport
    x:=4;y:=17
    SetTopaz(8)
    REPEAT
      scan(msgWin,x,y,prompt,answer)
      IF answer[]=0
        StrCopy(answer,'Speechless?',ALL)
      ELSEIF (answer[]="q") OR (answer[]="Q")
        StrCopy(answer,'Goodbye',ALL)
        done:=TRUE
      ENDIF
      clearLine(rp,x,y,20)
      display(rp,x,y,answer);display(rp,-1,-1,'!!!')
      Delay(75)
      clearLine(rp,x,y,20)
    UNTIL done
    CloseW(msgWin)
  ENDIF
  CleanUp(0)
EXCEPT
  IF msgWin THEN CloseW(msgWin)
  SELECT exception
    CASE "MEM"; WriteF('Out of memory!\n')
    CASE "WIN"; WriteF('Could not open window!\n')
  ENDSELECT
  CleanUp(exception)
ENDPROC